{-# LANGUAGE OverlappingInstances, FlexibleContexts, FlexibleInstances, UndecidableInstances, TypeSynonymInstances #-}

module Text.ParserCombinators.TableWithConfig (
   TableConfigParser, TPError,
   readTableWithConfig, get,
   liftL, liftR,
 ) where

import Control.Monad.Error
import Control.Monad.Reader

import Data.Either
import Data.Either.Utils
import Data.ConfigFile ( ConfigParser(..), CPError, SectionSpec, OptionSpec, readstring, emptyCP )
import Data.Typeable   ( Typeable, typeOf )

import Text.ParserCombinators.Table

import qualified Text.ParserCombinators.Parsec.Char as C
import qualified Data.ConfigFile                    as CF

type TableConfigParser = ConfigParser
data TPError           = CPError CPError | ParseError ParseError deriving Show

instance Error TPError where
    noMsg    = CPError $ noMsg
    strMsg x = CPError $ strMsg x

class Get a where
   get :: ConfigParser -> SectionSpec -> OptionSpec ->  Either TPError a

instance Get String where
   get cp s = liftL . CF.get cp s

instance (Read a, Typeable a) => Get a where
   get = getGeneric undefined

getGeneric :: (Read a, Typeable a) => a -> ConfigParser -> SectionSpec -> OptionSpec -> Either TPError a
getGeneric r cp s o = do
   val <- get cp s o
   case reads val of
      (v,""):_ -> return v
      _        -> liftL $ throwError (CF.ParseError $ "couldn't parse type " ++ (show $ typeOf r) ++ " " ++ val ++ " from " ++ "(" ++ s ++ "/" ++ o ++ ")", "get")

{--
get :: (Get_C a) => ConfigParser -> SectionSpec -> OptionSpec ->  Either TPError a
get cp s = liftL . CF.get cp s
--}

liftL = either (throwError.CPError   ) (return)
liftR = either (throwError.ParseError) (return)

readTableWithConfig :: String -> ReaderT TableConfigParser (Either TPError) (SParser a) -> Either TPError (ConfigParser, [a]) 
readTableWithConfig s m = do
  (h, t) <- liftR $ parse parser "" s
  cp     <- liftL $ readstring emptyCP {optionxform = map id} h
  r      <- liftR . parseTable t =<< runReaderT m cp
  return (cp, r)

parser = do
  c <- line `manyTill` try (eof <|> (C.string "#--" >> return ()))
  s <- anyToken `manyTill` eof
  return (concat c,s)

line :: Parser String
line = do
  skipMany ( C.char '#' <|> C.space )
  s <- many $ C.noneOf "\n"
  c <- option "" $ C.string "\n"
  return (s ++ c)